home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / hp8boo.bas < prev    next >
Encoding:
BASIC Source File  |  1988-08-16  |  22.7 KB  |  870 lines
  1. 10
  2. 20
  3. 30
  4. 35
  5. 40
  6. 45
  7. 50
  8. 60
  9. 70
  10. 80
  11. 90
  12. 100 DIM IBUFF$[264],OBUFF$[264]
  13. 105 DIM K$[1],k$[1],I$[256]
  14. 110 DIM CR$[1],LF$[1],ESC$[1],BEL$[1]
  15. 115 DIM EL$[1],BS$[1],DEL$[1],NULL$[1]
  16. 120 DIM SP$[1]
  17. 125 INTEGER S1,S2,S3,S4,K,R,C,I,F
  18. 130 CR$[1]=CHR$ (13) @ LF$=CHR$ (10)
  19. 135 ESC$[1]=CHR$ (27) @ BEL$=CHR$ (7)
  20. 140 EL$[1]=CHR$ (154) @ BS$=CHR$ (155)
  21. 145 DEL$[1]=CHR$ (127) @ NULL$=CHR$ (0)
  22. 150 SP$=" "
  23. 155 DIM RP$[96],OP$[96],ID$[91],OD$[91]
  24. 160 DIM S$[256],DB$[256],SF$[17],DF$[40],T$[1],RT$[1],c$[1]
  25. 165 DIM SI$[1],SH$[1],SD$[1],SE$[1],SB$[1],TM$[1],AK$[1],NK$[1]
  26. 170 DIM RQCTL$[1],SQCTL$[1],RPADC$[1],SPADC$[1]
  27. 175 DIM MK$[1],SEOL$[1],REOL$[1],CRLF$[4]
  28. 180 INTEGER N,S,T,e,f,i,j,l,m,r,t
  29. 185 INTEGER n,rn,db,tmo,nk,bp,rr,rc,sr,sc
  30. 190 INTEGER RMAXL,SMAXL,MAXL,MINL,RTO,STO,RNPAD,SNPAD,REOL,SEOL,TMO,STM,RLIM
  31. 195 SI$="S" @ SH$="F" @ SD$="D" @ SE$="Z" @ SB$="B"
  32. 200 AK$="Y" @ NK$="N" @ TM$="T" @ ER$="E"
  33. 205 MK$=CHR$ (1) @ CRLF$="#M#J"
  34. 210 SEOL$,REOL$=CR$ @ RPADC$=NULL$ @ SQCTL$="#"
  35. 215 RMAXL=94 @ RTO,STO=20 @ RNPAD=0 @ SEOL=13
  36. 220 RLIM=10 @ STM=10000 @ rr=17 @ sr=15 @ rc,sc=10
  37. 225 db=1
  38. 250 DIM F$[80],CL$[61],CP$[24]
  39. 255 CL$="CONNECT, SEND, RECEIVE, SET, SHOW, EXIT, QUIT, CAT"
  40. 260 KP$="KERMIT-HP86" @ CP$=KP$
  41. 265 DIM VC$[63],DT$[1],CN$[1],UL$[1],FTYP$[8]
  42. 270 VC$=".1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  43. 275 DT$="." @ CN$=":" @ UL$="_" @ Q$=CHR$ (34)
  44. 280 FTYP$="DATA"
  45. 300 ALPHALL @ PAGESIZE 24 @ CLEAR @ R=0
  46. 310 DIM EM$(24)[24]
  47. 320 EM$(0)="Transfer successfull" @ EM$(1)="Timeout receiving"
  48. 325 EM$(2)="NAK received" @ EM$(3)="Checksum error" @ EM$(4)="Incorrect packet"
  49. 330 EM$(5)="Timeout sending" @ EM$(6)="Cannot rename file"
  50. 335 EM$(7)="Disc write protected" @ EM$(8)="*File closed*"
  51. 340 EM$(9)="File does not exist" @ EM$(10)="Incorrect file type"
  52. 345 EM$(11)="*Random overflow*" @ EM$(12)="Read error"
  53. 350 EM$(13)="End of file" @ EM$(14)="Record does not exist"
  54. 355 EM$(15)="No M.S. device" @ EM$(16)="Directory full"
  55. 360 EM$(17)="Volume not found" @ EM$(18)="MSUS not found"
  56. 365 EM$(19)="Read verify error" @ EM$(20)="Disc full"
  57. 370 EM$(21)="Medium damaged" @ EM$(22)="Disc drive fault"
  58. 372 EM$(23)="Data type error" @ EM$(24)="Transfer aborted"
  59. 375 FSE$=CHR$ (60) @ FOR i=66 TO 72 @ FSE$=FSE$&CHR$ (i) @ NEXT i
  60. 380 FSE$=FSE$&CHR$ (120) @ FOR i=124 TO 130 @ FSE$=FSE$&CHR$ (i) @ NEXT i
  61. 390 DIM A$(9)[18],ST$(1)[9],st$(1)[8]
  62. 395 A$(0)="initialise        " @ A$(1)="file header      "
  63. 400 A$(2)="data              " @ A$(3)="end of file      "
  64. 405 A$(4)="break             " @ A$(5)="error            "
  65. 410 A$(6)="ACK               " @ A$(7)="NAK              "
  66. 415 A$(8)="file header/break " @ A$(9)="data/EOF         "
  67. 420 ST$(0)="Sending" @ st$(0)="sent" @ ST$(1)="Receiving" @ st$(1)="received"
  68. 425 DIM RE$[4],PF$[18]
  69. 430 INTEGER RE,RL,NR
  70. 435 RE$=CR$&LF$ @ RE=LEN (RE$) @ RL=256 @ NR=40 @ FS=RL*NR/1024 @ PF$=""
  71. 440 DIM SL$[164],OO$[7],DX$[10],FC$[23],PT$[28],BR$[8],HS$[29]
  72. 445 SL$="TIMEOUT, RETRIES, SEND-CONVERT, DEBUG, PREFIX, END-OF-LINE, "
  73. 450 SL$=SL$&"RECORD-END, FILE-SIZE, RECORD-LENGTH, NO-OF-RECORDS, "
  74. 455 SL$=SL$&"DUPLEX, LOCAL-ECHO, FLOW-CONTROL, HANDSHAKE, PARITY"
  75. 460 OO$="OFF, ON" @ DX$="FULL, HALF" @ FC$="NONE, XON/XOFF, DTR/RTS"
  76. 462 PT$="NONE, ODD, EVEN, MARK, SPACE" @ BR$="110, 300"
  77. 463 HS$="NONE, BELL, LF, CR, XON, XOFF"
  78. 465 DIM SS$[47],RS$[32]
  79. 470 SS$="SEND "&Q$&"Source filename"&Q$&" <"&Q$&"Destination filespec"&Q$&">"
  80. 475 RS$="RECEIVE <"&Q$&"Destination filespec"&Q$&">"
  81. 480 DIM IO$[14],IC$[14],IV$[13]
  82. 485 IO$="Illegal option" @ IC$="Illegal string" @ IV$="Illegal value"
  83. 490 INTEGER BR,DX,LE,FC,HS,PT,SC,ps
  84. 495 BR,DX,LE=1 @ PT=3 @ FC,SC,ps=0 @ HS=4 @ GOSUB rs_set
  85. 500
  86. 510
  87. 520
  88. 530
  89. 540
  90. 550
  91. 560
  92. 570
  93. 580
  94. 590
  95. 600 com_proc: GOSUB dkeys
  96. 610 AWRITE 20,0 @ DISP CP$&" > Enter command ";! Display command prompt
  97. 620 RELEASE KEYBOARD
  98. 630 INPUT S$@ CP$=KP$
  99. 640 TAKE KEYBOARD
  100. 645 AWRITE 19,0,RPT$ (" ",80)
  101. 646 AWRITE 22,0,RPT$ (" ",160)
  102. 650 GOSUB split
  103. 660 C=FNinlist(F$,CL$)
  104. 670 IF C=0 THEN AWRITE 22,0,"Invalid command - "&F$
  105. 675 IF C<1 THEN 610
  106. 680 ON C GOSUB connect ,send_file ,rec_file ,set ,show_pars ,exit ,exit ,dir
  107. 690 GOTO com_proc
  108. 700
  109. 710
  110. 720
  111. 730 split: S$=TRIM$ (S$)
  112. 740 p=POS (S$,Q$) @ P=POS (S$,SP$)
  113. 745 IF p*P=0 THEN P=MAX (P,p) ELSE P=MIN (P,p)
  114. 750 IF P=0 THEN F$=S$ @ S$="" ELSE F$=S$[1,P-1] @ S$=S$[P,LEN (S$)]
  115. 760 RETURN
  116. 850
  117. 860
  118. 870
  119. 880 exit: CLEAR @ RELEASE KEYBOARD @ ABORTIO 10 @ DISP "Kermit finished" @ END
  120. 900
  121. 910
  122. 920
  123. 930 dir: ON ERROR GOSUB fserr  @ f=0
  124. 935 S$=TRIM$ (S$) @ IF S$#"" THEN CAT S$ ELSE CAT
  125. 940 IF f#0 THEN AWRITE 19,0,EM$(f) @ RETURN
  126. 950 FOR I=1 TO 4 @ DISP @ NEXT I @ RETURN
  127. 1000
  128. 1010
  129. 1020
  130. 1030
  131. 1040
  132. 1050 connect: F,f=0
  133. 1070 C=0 @ START CRT AT R
  134. 1080 AWRITE 0,0 @ CLEAR
  135. 1090 DISP "HP86 Kermit - Terminal emulation mode" @ DISP
  136. 1100 DISP "Function key   Escape character   Action"
  137. 1110 DISP "--------------------------------------------------"
  138. 1120 DISP "   k1                 C           Return to KERMIT"
  139. 1130 DISP "   k7                 B           Transmit break"
  140. 1135 DISP "   k14                            Enable transmit"
  141. 1140 AWRITE 23,0
  142. 1150 DEL=5
  143. 1160 ON KEY# 1 GOTO EXIT1
  144. 1170 ON KEY# 7 GOSUB BREAK
  145. 1172 ON KEY# 14 GOSUB TX_EN
  146. 1180 ON EOT 10 GOSUB BUFFULL
  147. 1190 TAKE KEYBOARD
  148. 1200 k$=" " @ AWRITE 23,0,HGL?$ (k$,1)
  149. 1210
  150. 1220
  151. 1230
  152. 1240 START: STATUS 10,9 ; S1,S2
  153. 1250
  154. 1260
  155. 1270 IF BINAND (S1,128)=0 OR BINAND (S2,32)=0 THEN RSGET
  156. 1280
  157. 1290
  158. 1300
  159. 1310 K$=KEY$  @ IF K$="" THEN RSGET
  160. 1320 IF F=0 THEN KOUT ELSE F=0
  161. 1330 IF K$=ESC$ THEN 1500
  162. 1340 IF K$="C" OR K$="c" THEN EXIT1
  163. 1350 IF K$="B" OR K$="b" THEN GOSUB BREAK
  164. 1360 GOTO START
  165. 1370 KOUT: IF K$=BS$ THEN K$=DEL$
  166. 1380 IF K$=EL$ THEN K$=CR$ @ f=HS#0
  167. 1390 IF K$=ESC$ THEN F=1 @ BEEP @ GOTO RSGET
  168. 1400 IF K$>DEL$ THEN RSGET
  169. 1405 IF LE=0 THEN 1500
  170. 1410 AWRITE 23,C,k$
  171. 1420 IF K$ >= SP$ THEN 1450
  172. 1430 IF K$=CR$ THEN C=0 @ GOTO 1490
  173. 1440 IF K$=LF$ THEN 1470
  174. 1450 AWRITE 23,C,K$
  175. 1460 C=C+1 @ IF C<80 THEN 1490 ELSE C=0
  176. 1470 R=R+1 @ IF R=204 THEN R=0
  177. 1480 AWRITE 24,0,RPT$ (SP$,80) @ START CRT AT R
  178. 1490 AWRITE 23,C @ AREAD k$ @ AWRITE 23,C,HGL?$ (k$,1)
  179. 1500 OUTPUT OBUFF$ USING "#,A" ; K$
  180. 1502 IF f THEN OUTPUT OBUFF$ USING "#,A" ; HC$
  181. 1506 STATUS OBUFF$,1 ; S1,S,S3
  182. 1508 IF S1=0 OR S3#0 THEN 1520
  183. 1510 TRANSFER OBUFF$ TO  10 INTR
  184. 1520 WAIT DEL
  185. 1530
  186. 1540
  187. 1550
  188. 1560 RSGET: STATUS IBUFF$,1 ; S3
  189. 1565 IF S3=0 THEN START
  190. 1570 AWRITE 23,C,k$
  191. 1580 ENTER IBUFF$ USING "#,#K" ; I$
  192. 1590 FOR I=1 TO LEN (I$)
  193. 1600 K$=I$[I,I]
  194. 1610 IF K$ >= SP$ THEN 1660
  195. 1620 IF K$=CR$ THEN C=0 @ GOTO 1700
  196. 1630 IF K$=LF$ THEN 1680
  197. 1640 IF K$=BEL$ THEN BEEP @ GOTO 1700
  198. 1650 GOTO 1700
  199. 1660 AWRITE 23,C,K$
  200. 1670 C=C+1 @ IF C<80 THEN 1700 ELSE C=0
  201. 1680 R=R+1 @ IF R=204 THEN R=0
  202. 1690 AWRITE 24,0,RPT$ (SP$,80) @ START CRT AT R
  203. 1700 NEXT I
  204. 1710 AWRITE 23,C @ AREAD k$ @ AWRITE 23,C,HGL?$ (k$,1)
  205. 1720 GOTO START
  206. 1730
  207. 1740
  208. 1750
  209. 1760 BUFFULL: OFF EOT 10 @ STATUS 10,11 ; S4
  210. 1765 IF BINAND (S4,64)#0 THEN 1810
  211. 1770 IF f=0 THEN 1850
  212. 1780 f=0 @ STATUS 10,9 ; S@ S=BINAND (S,127)
  213. 1790 ABORTIO 10 @ CONTROL 10,9 ; S@ TRANSFER 10 TO  IBUFF$ INTR
  214. 1800 GOTO 1850
  215. 1810 ENTER IBUFF$ USING "#,#K" ; I$@ TRANSFER 10 TO  IBUFF$ INTR
  216. 1820
  217. 1830 DISP I$
  218. 1840 DISP "BUFFER FULL POSSIBLE DATA LOSS !"
  219. 1850 ON EOT 10 GOSUB BUFFULL  @ RETURN
  220. 1860
  221. 1870
  222. 1880
  223. 1890 EXIT1:
  224. 1900 RELEASE KEYBOARD @ OFF EOT 10 @ CLEAR
  225. 1910 RETURN
  226. 1920
  227. 1930
  228. 1940
  229. 1950 BREAK: REQUEST 10;8 @ RETURN
  230. 1960
  231. 1970
  232. 1980
  233. 1990 TX_EN: RESUME 10 @ RETURN
  234. 2000
  235. 2010
  236. 2020
  237. 2030
  238. 2040
  239. 2050
  240. 2060
  241. 2070
  242. 2080
  243. 2160
  244. 2170
  245. 2180
  246. 2190 send_file: S$=TRIM$ (S$) @ DF$=""
  247. 2195 IF S$="?" THEN AWRITE 22,0,SS$ @ RETURN
  248. 2200 p=FNfsplit(S$) @ IF p=0 THEN errfn
  249. 2210 SF$=TRIM$ (S$[2,p])
  250. 2220 IF l<p+2 THEN volrem
  251. 2230 S$=TRIM$ (S$[p+2,l])
  252. 2240 p=FNfsplit(S$) @ IF p=0 THEN errfn
  253. 2250 S$=TRIM$ (S$[2,p]) @ GOTO chckfn
  254. 2260
  255. 2270
  256. 2280
  257. 2290 volrem: S$=SF$
  258. 2300 p=POS (S$,DT$) @ IF p=0 THEN p=POS (S$,CN$)
  259. 2310 IF p>0 THEN S$=S$[1,p-1]
  260. 2320
  261. 2330
  262. 2340
  263. 2350 chckfn: l=LEN (S$) @ f=0 @ j=0
  264. 2360 S$=UPC$ (S$)
  265. 2370 IF POS (S$,DT$) THEN 2410
  266. 2380 p=POS (S$,SP$) @ IF p>0 THEN 2400
  267. 2390 p=POS (S$,UL$) @ IF p=0 THEN 2410
  268. 2400 S$[p,p]=DT$
  269. 2410 FOR i=1 TO l @ p=POS (VC$,S$[i,i])
  270. 2420 IF p=0 OR p=1 AND (f=1 OR j=0 OR j=l-1) THEN 2450
  271. 2430 IF p=1 THEN f=1
  272. 2440 j=j+1 @ DF$[j,j]=S$[i,i]
  273. 2450 NEXT i
  274. 2460 IF j=0 THEN DF$=SF$ @ GOTO 2800
  275. 2470 l=LEN (DF$) @ p=POS (DF$,DT$)
  276. 2480 IF p=0 THEN DF$=DF$&"." @ p=l
  277. 2490 IF p=l THEN DF$=DF$&FTYP$
  278. 2600
  279. 2610
  280. 2620
  281. 2630
  282. 2640
  283. 2650
  284. 2660
  285. 2670
  286. 2680
  287. 2690
  288. 2700
  289. 2710
  290. 2720
  291. 2730
  292. 2740
  293. 2750
  294. 2760
  295. 2770
  296. 2780
  297. 2790
  298. 2800 n,pc,st,k,SNPAD=0 @ RT$="" @ sr=15 @ rr=17
  299. 2805 GOSUB open_read  @ IF f#0 THEN srexit
  300. 2810 GOSUB dsend  @ ON KEY# 1 GOSUB abort
  301. 2815
  302. 2820
  303. 2830
  304. 2840 send_init: n=0 @ T$=SI$ @ T=0 @ IBUFF$=""
  305. 2845 GOSUB init_pack  @ OD$=IN$
  306. 2890 GOSUB send_pack  @ IF f#0 THEN srexit
  307. 2900
  308. 2910
  309. 2920
  310. 2930 GOSUB dcd_init
  311. 3010
  312. 3020
  313. 3030
  314. 3040 send_head: T$=SH$ @ T=1 @ OD$=DF$
  315. 3050 GOSUB send_pack  @ IF f#0 THEN srexit
  316. 3060
  317. 3070
  318. 3080
  319. 3090 T$=SD$ @ T=2 @ DB$="" @ e=0 @ MAXL=SMAXL-3
  320. 3100 MINL=IP (MAXL/2) @ IF MINL<1 THEN MINL=1
  321. 3110 GOSUB get_data  @ IF f#0 THEN RETURN
  322. 3120 IF OD$="" THEN send_eof
  323. 3130 GOSUB send_pack  @ IF f#0 THEN srexit
  324. 3135 IF LEN (ID$)=0 THEN 3110
  325. 3140 IF ID$[1,1]#"Z" AND ID$[1,1]#"X" THEN 3110
  326. 3150
  327. 3160
  328. 3170
  329. 3180 send_eof: T$=SE$ @ T=3
  330. 3190 GOSUB send_pack  @ IF f#0 THEN srexit
  331. 3200 T$=SB$ @ T=4 @ GOSUB send_pack
  332. 3210 GOTO srexit
  333. 3510
  334. 3520
  335. 3530
  336. 3540 errfn: CP$="Filename error" @ RETURN
  337. 4000
  338. 4010
  339. 4020
  340. 4030
  341. 4040
  342. 4050
  343. 4060
  344. 4070
  345. 4080 rec_file: S$=TRIM$ (S$)
  346. 4083 IF S$="?" THEN AWRITE 22,0,RS$ @ RETURN
  347. 4085 sr=17 @ rr=15 @ st=1 @ GOSUB dsend
  348. 4090 p=FNfsplit(S$) @ IF p=0 THEN ft=1 @ GOTO 4200
  349. 4100 DF$=TRIM$ (S$[2,p]) @ ft=0
  350. 4110 p=POS (DF$,DT$) @ IF p=0 THEN p=POS (DF$,CN$)
  351. 4120 IF p=0 THEN 4150
  352. 4130 VN$=DF$[p] @ IF p=1 OR LEN (VN$)>6 THEN errfn
  353. 4140 DF$=DF$[1,p-1]
  354. 4150 IF LEN (DF$)>10 THEN errfn
  355. 4155 AWRITE 4,2,ST$(1)&" as '"&DF$&"'"
  356. 4160
  357. 4170
  358. 4180
  359. 4200 rec_init: n,nf,pc,k=0 @ IBUFF$="" @ ON KEY# 1 GOSUB abort
  360. 4210 GOSUB init_pack  @ A$=SI$ @ T=0
  361. 4220 GOSUB get_pack  @ IF f#0 THEN srexit
  362. 4230 GOSUB dcd_init
  363. 4232
  364. 4234
  365. 4236
  366. 4240 rec_head: A$="FBSZ" @ DB$=""
  367. 4250 T=8 @ GOSUB get_pack
  368. 4260 IF RT$=SB$ OR f#0 THEN srexit
  369. 4262
  370. 4264
  371. 4266
  372. 4270 SF$=ID$ @ k=0
  373. 4272 IF ft=0 THEN 4330 ELSE DF$=SF$
  374. 4275 l=LEN (DF$) @ p=POS (DF$,DT$)
  375. 4280 IF l=0 THEN DF$=DFN$&DFT$ @ GOTO 4275
  376. 4285 IF p=0 THEN 4330
  377. 4290 IF p=l THEN DF$=DF$&DFT$ @ GOTO 4275
  378. 4295 IF p=1 THEN DF$=DFN$&DF$ @ GOTO 4275
  379. 4300 F$=DF$[1,p-1] @ IF LEN (F$)>6 THEN F$=F$[1,6]
  380. 4310 S$=DF$[p+1,l] @ IF LEN (S$)>3 THEN S$=S$[1,3]
  381. 4320 DF$=F$&SP$&S$ @ ft=LEN (F$)+1
  382. 4330 GOSUB open_write  @ IF f#0 THEN srexit
  383. 4335 AWRITE 4,2,ST$(1)&" '"&SF$&"' as '"&DF$&"'"
  384. 4340
  385. 4350
  386. 4360
  387. 4370 rec_data: A$="DZF" @ T=9
  388. 4380 GOSUB get_pack  @ IF f#0 THEN srexit
  389. 4390 IF RT$=SE$ THEN GOSUB close_write  @ GOTO rec_head
  390. 4400 GOSUB put_data  @ IF f#0 THEN srexit
  391. 4410 GOTO rec_data
  392. 5000
  393. 5010
  394. 5020
  395. 5030
  396. 5040
  397. 5050 show_pars: IF S$="" THEN sa
  398. 5060 set: GOSUB split  @ S$=TRIM$ (S$)
  399. 5070 p=FNinlist(F$,SL$)
  400. 5080 IF p<1 THEN DF$=F$ @ I$=IO$ @ GOTO 5150
  401. 5090 I$=FNxlist$(SL$,p)
  402. 5100 IF C=5 THEN 5140
  403. 5110 DF$=S$ @ O=p
  404. 5115
  405. 5120 ON p GOSUB S0 ,S1 ,S2 ,S3 ,S4 ,S5 ,S6 ,S7 ,S8 ,S9 ,S10 ,S11 ,S12 ,S13 ,S14
  406. 5130 IF p<1 THEN 5150 ELSE p=O @ S$=DF$
  407. 5135
  408. 5140 ON p GOSUB s0 ,s1 ,s2 ,s3 ,s4 ,s5 ,s6 ,s7 ,s8 ,s9 ,s10 ,s11 ,s12 ,s13 ,s14
  409. 5150 IF p>-1 THEN AWRITE 22,0,I$&" - "&DF$
  410. 5160 RETURN
  411. 5500
  412. 5510
  413. 5520
  414. 5530
  415. 5540
  416. 5550 S0: RTO=FNpval(S$,RTO) @ RETURN
  417. 5560 S1: RLIM=FNpval(S$,RLIM) @ RETURN
  418. 5570 S2: ps=FNlset(S$,SC,OO$) @ RETURN
  419. 5580 S3: db=FNlset(S$,db,OO$) @ RETURN
  420. 5590 S4: p=0 @ IF LEN (S$)#1 THEN I$=IC$ @ RETURN
  421. 5600 SQCTL$=S$ @ RETURN
  422. 5610 S5: SEOL=FNpval(S$,SEOL) @ RETURN
  423. 5620 S6: T=0 @ DB$=""
  424. 5630 GOSUB split  @ k=FNpval(F$,0)
  425. 5640 IF k=0 THEN RETURN
  426. 5650 DB$=DB$&CHR$ (k) @ T=T+1
  427. 5660 IF S$#"" AND T<4 THEN 5630
  428. 5670 RE=T @ RE$=DB$ @ p=7 @ RETURN
  429. 5680 S7: FS=FNpval(S$,FS) @ NR=FS*1024/RL @ RETURN
  430. 5690 S8: RL=FNpval(S$,RL) @ NR=FS*1024/RL @ RETURN
  431. 5700 S9: NR=FNpval(S$,NR) @ FS=NR*RL/1024 @ RETURN
  432. 5710 S10: DX=FNlset(S$,DX,DX$) @ LE=DX @ GOTO 5760
  433. 5720 S11: LE=FNlset(S$,LE,OO$) @ GOTO 5760
  434. 5730 S12: FC=FNlset(S$,FC,FC$) @ IF FC#0 THEN HS=0
  435. 5735 GOTO 5760
  436. 5740 S13: HS=FNlset(S$,HS,HS$) @ IF HS#0 THEN FC=0
  437. 5745 GOTO 5760
  438. 5750 S14: PT=FNlset(S$,PT,PT$)
  439. 5760 GOSUB rs_set  @ RETURN
  440. 5770
  441. 6000
  442. 6010
  443. 6020
  444. 6030
  445. 6040
  446. 6110 sa: CLEAR
  447. 6120 FOR N=0 TO 14 @ n=N+1
  448. 6130 AWRITE 2+N DIV 2,40*(N MOD 2),FNxlist$(SL$,n)
  449. 6140 ON n GOSUB s0 ,s1 ,s2 ,s3 ,s4 ,s5 ,s6 ,s7 ,s8 ,s9 ,s10 ,s11 ,s12 ,s13 ,s14
  450. 6150 AWRITE 2+N DIV 2,15+40*(N MOD 2),DF$
  451. 6160 NEXT N
  452. 6170 RETURN
  453. 6200 s0: DF$=VAL$ (RTO) @ RETURN
  454. 6210 s1: DF$=VAL$ (RLIM) @ RETURN
  455. 6220 s2: DF$=FNxlist$(OO$,SC+1) @ RETURN
  456. 6230 s3: DF$=FNxlist$(OO$,db+1) @ RETURN
  457. 6240 s4: DF$=SQCTL$ @ RETURN
  458. 6250 s5: DF$=VAL$ (SEOL) @ RETURN
  459. 6260 s6: DF$=""
  460. 6262 FOR I=1 TO RE @ DF$=DF$&VAL$ (NUM (RE$[I,I]))&SP$ @ NEXT I
  461. 6265 RETURN
  462. 6270 s7: DF$=VAL$ (FS)&"k" @ RETURN
  463. 6280 s8: DF$=VAL$ (RL) @ RETURN
  464. 6290 s9: DF$=VAL$ (NR) @ RETURN
  465. 6300 s10: DF$=FNxlist$(DX$,DX+1) @ RETURN
  466. 6310 s11: DF$=FNxlist$(OO$,LE+1) @ RETURN
  467. 6320 s12: DF$=FNxlist$(FC$,FC+1) @ RETURN
  468. 6330 s13: DF$=FNxlist$(HS$,HS+1) @ RETURN
  469. 6340 s14: DF$=FNxlist$(PT$,PT+1) @ RETURN
  470. 10000
  471. 10010
  472. 10020
  473. 10030
  474. 10040
  475. 10050
  476. 10060
  477. 10070
  478. 10080 rec_pack: m=0 @ ID$=""
  479. 10090 ON TIMER# 1,TMO GOTO rto
  480. 10100 b_chk: STATUS IBUFF$,1 ; S
  481. 10105 K$=KEY$  @ IF K$#"" THEN rto
  482. 10110 IF S=0 THEN WAIT TMO/5 @ GOTO b_chk
  483. 10120 ENTER IBUFF$ USING "#,#K" ; I$
  484. 10130 l=LEN (I$) @ i=1
  485. 10140 n_chr: k$=I$[i,i]
  486. 10145 IF k$=MK$ THEN m=1 @ RP$="" @ j=0
  487. 10150 IF m=0 THEN i_chr
  488. 10160 IF k$=REOL$ THEN e_pck
  489. 10170 RP$=RP$&k$ @ j=j+1
  490. 10180 i_chr: i=i+1 @ IF i>l THEN b_chk ELSE n_chr
  491. 10190 e_pck: IF j<5 THEN 10100
  492. 10200 OFF TIMER# 1
  493. 10210 IF i<l THEN IBUFF$=I$[i+1,l]&IBUFF$
  494. 10220 IF db=1 THEN AWRITE rr,rc,RP$
  495. 10230 c$=FNcbyte$(RP$[2,j-1])
  496. 10240 IF c$#RP$[j,j] THEN RT$=FNstbit$(RP$[j]) @ bp=bp+1 @ RETURN
  497. 10250 RT$=RP$[4,4] @ rn=FNunchar(RP$[3,3])
  498. 10260 f=0 @ FOR i=5 TO j-1 @ k$=RP$[i,i]
  499. 10270 IF f=0 THEN 10300
  500. 10280 IF k$#RQCTL$ THEN k$=FNctl$(k$)
  501. 10290 f=0 @ GOTO 10310
  502. 10300 IF k$=RQCTL$ THEN f=1 @ GOTO 10320
  503. 10310 ID$=ID$&k$
  504. 10320 NEXT i @ RETURN
  505. 10330 rto: OFF TIMER# 1
  506. 10333 IF m=1 THEN m=2 @ GOTO 10090
  507. 10335 IF HS#0 THEN RESUME 10
  508. 10338 tmo=tmo+1 @ RT$="T" @ RETURN
  509. 10340
  510. 10350
  511. 10360
  512. 10370 send_pack: f=0 @ r=0 @ GOSUB c_pack
  513. 10380 send1: s=T @ GOSUB disp_state
  514. 10390 IF db THEN AWRITE sr,0,RPT$ (SP$,320) @ AWRITE sr,sc,OP$
  515. 10400 GOSUB send_buff  @ IF f#0 THEN RETURN
  516. 10410 s=6 @ GOSUB disp_state  @ GOSUB rec_pack
  517. 10415 IF RT$>DEL$ OR RT$=TM$ THEN 10450
  518. 10420 N=BINAND (rn-BINAND (n,63),63) @ f=0
  519. 10430 IF RT$=AK$ AND N=0 OR RT$=NK$ AND N=1 THEN pc,n=n+1 @ RETURN
  520. 10435 IF RT$=AK$ AND N=63 THEN 10410
  521. 10440 IF RT$#NK$ THEN f=4 @ RETURN ELSE nk=nk+1
  522. 10450 r=r+1 @ IF r<RLIM THEN send1
  523. 10460 IF RT$=TM$ THEN f=1 @ RETURN
  524. 10470 IF RT$=NK$ THEN f=2 ELSE f=3
  525. 10480 RETURN
  526. 10510
  527. 10520
  528. 10530
  529. 10540 c_pack: OP$=FNchar$(BINAND (n,63))&T$&OD$
  530. 10550 OP$=FNchar$(LEN (OP$)+1)&OP$
  531. 10560 OP$=MK$&OP$&FNcbyte$(OP$)
  532. 10570 IF SNPAD>0 THEN OBUFF$=RPT$ (SPADC$,SNPAD)
  533. 10580 OUTPUT OBUFF$ USING "#,K" ; OP$&CHR$ (SEOL)
  534. 10585 IF HS#0 THEN OUTPUT OBUFF$ USING "#,A" ; HC$
  535. 10590 STATUS OBUFF$,1 ; bl@ RETURN
  536. 10600
  537. 10610
  538. 10620 send_buff:
  539. 10630 ON TIMER# 1,STM GOTO 10690
  540. 10640 CONTROL OBUFF$,1 ; bl
  541. 10650 TRANSFER OBUFF$ TO  10 INTR
  542. 10660 STATUS OBUFF$,1 ; S
  543. 10670 IF S>0 THEN 10660
  544. 10673 IF HS=0 THEN 10680
  545. 10675 STATUS 10,9 ; S@ S=BINAND (S,127)
  546. 10678 ABORTIO 10 @ CONTROL 10,9 ; S@ TRANSFER 10 TO  IBUFF$ INTR
  547. 10680 OFF TIMER# 1 @ IBUFF$=""
  548. 10685 RETURN
  549. 10690 f=5 @ OFF TIMER# 1 @ RETURN
  550. 10700
  551. 10710
  552. 10720
  553. 10730 get_pack: r=0
  554. 10740 s=T @ GOSUB disp_state  @ AWRITE rr,0,RPT$ (SP$,320)
  555. 10745 f,p=0 @ GOSUB rec_pack
  556. 10750 IF RT$=TM$ THEN f=1 @ GOTO 10830
  557. 10760 IF RT$>DEL$ THEN f=3 @ GOTO 10830
  558. 10770 p=POS (A$,RT$) @ N=BINAND (rn-n,63)
  559. 10780 IF N#0 AND N#63 OR p=0 THEN f=4 @ RETURN
  560. 10790 OD$="" @ IF RT$=SI$ THEN OD$=IN$
  561. 10800 T$=AK$ @ s=6 @ n=rn @ GOSUB c_pack
  562. 10810 n=(n+1) MOD 64 @ GOTO 10850
  563. 10830 r=r+1 @ IF r>RLIM THEN RETURN
  564. 10840 T$=NK$ @ s=7 @ OD$="" @ nk=nk+1 @ GOSUB c_pack
  565. 10850 GOSUB disp_state  @ IF db THEN AWRITE sr,sc,OP$
  566. 10860 f=0 @ GOSUB send_buff  @ IF f#0 THEN RETURN
  567. 10870 IF p#1 AND p#2 OR N#0 THEN 10740
  568. 10880 pc=pc+1 @ RETURN
  569. 11000
  570. 11010
  571. 11020
  572. 11030
  573. 11040
  574. 11050
  575. 11060
  576. 11070
  577. 11080 init_pack: tmo,nk,bp=0
  578. 11090 TMO=RTO*1000
  579. 11100 IN$=FNchar$(RMAXL)
  580. 11110 IN$=IN$&FNchar$(STO)
  581. 11120 IN$=IN$&FNchar$(RNPAD)&FNctl$(RPADC$)
  582. 11130 IN$=IN$&FNchar$(SEOL)&SQCTL$
  583. 11140 SMAXL=80 @ SNPAD=0 @ SPADC$=NULL$ @ REOL=13 @ RQCTL$="#"
  584. 11150 RETURN
  585. 11160
  586. 11170
  587. 11180
  588. 11190 dcd_init: l=LEN (RP$)-5 @ IF l=0 THEN RETURN
  589. 11200 IF l<7 THEN ON l GOTO maxl ,tmo ,npad ,padc ,elc ,qctl
  590. 11210 qctl: IF RP$[10,10]#SP$ THEN RQCTL$=RP$[10,10]
  591. 11220 elc: IF RP$[9,9]#SP$ THEN SEOL=FNunchar(RP$[9,9])
  592. 11230 padc: IF RP$[8,8]#SP$ THEN SPADC$=FNctl$(RP$[8,8])
  593. 11240 npad: IF RP$[7,7]#SP$ THEN SNPAD=FNunchar(RP$[7,7])
  594. 11250 tmo: IF RP$[6,6]#SP$ THEN RTO=FNunchar(RP$[6,6])
  595. 11260 maxl: IF RP$[5,5]#SP$ THEN SMAXL=FNunchar(RP$[5,5])
  596. 11270 RETURN
  597. 12000
  598. 12010
  599. 12020
  600. 12030 srexit: IF f=0 OR f=5 THEN 12080
  601. 12040 IF f#4 OR RT$#ER$ THEN 12060
  602. 12050 AWRITE 19,0,"Error message from remote - "&ID$ @ RETURN
  603. 12060 OD$=EM$(f) @ T$=ER$ @ T=5
  604. 12070 GOSUB c_pack  @ GOSUB send_buff
  605. 12080 AWRITE 19,0,EM$(f)
  606. 12082 BEEP (f#1)*20+20,200
  607. 12085 IF f>6 AND f<23 THEN AWRITE 19,LEN (EM$(f))+1,"(error no - "&VAL$ (e)&")"
  608. 12090 RETURN
  609. 12100
  610. 12110
  611. 12120
  612. 12130 abort: f=24 @ RETURN
  613. 20000
  614. 20010
  615. 20020
  616. 20030
  617. 20040
  618. 20050
  619. 20060
  620. 20070
  621. 20080 DEF FNchar$(n) = CHR$ (n+32)
  622. 20090
  623. 20100
  624. 20110
  625. 20120 DEF FNunchar(c$[1]) = NUM (c$)-32
  626. 20130
  627. 20140
  628. 20150
  629. 20160 DEF FNctl$(c$[1]) = CHR$ (BINEOR (NUM (c$),64))
  630. 20170
  631. 20180
  632. 20190
  633. 20200 DEF FNstbit$(c$[1]) = CHR$ (BINEOR (NUM (c$),128))
  634. 20210
  635. 20220
  636. 20230
  637. 20240 DEF FNcbyte$(S$[96])
  638. 20250 t=0 @ l=LEN (S$) @ FOR i=1 TO l @ t=t+NUM (S$[i,i]) @ NEXT i
  639. 20260 FNcbyte$=FNchar$(BINAND (t+BINAND (t,192)/64,63))
  640. 20270 FN END
  641. 30000
  642. 30010
  643. 30020
  644. 30030
  645. 30040
  646. 30050
  647. 30060
  648. 30070
  649. 30080
  650. 30090
  651. 30100
  652. 30110
  653. 30120
  654. 30130
  655. 30140
  656. 30150
  657. 30260
  658. 30270
  659. 30280
  660. 30290 dsend: CLEAR
  661. 30300 AWRITE 1,2,"HP86 Kermit - "&ST$(st)&" file"
  662. 30310 AWRITE 2,2,RPT$ ("-",LEN (ST$(st))+19)
  663. 30320 IF st=0 THEN AWRITE 4,2,ST$(st)&" "&SF$&" as "&DF$
  664. 30330 AWRITE 6,2,"Current action :" @ AWRITE 6,46,"Retries :"
  665. 30340 AWRITE 8,2,"Packets          :" @ AWRITE 8,40,"NAKs          :"
  666. 30350 AWRITE 9,2,"Bytes            :" @ AWRITE 9,40,"Timeouts      :"
  667. 30360 AWRITE 10,40,"Bad packets   :"
  668. 30370 AWRITE 8,10,st$(st) @ AWRITE 8,45,st$(1-st) @ AWRITE 9,8,st$(st)
  669. 30380 RETURN
  670. 30390
  671. 30400
  672. 30410
  673. 30420 disp_state: t=s>7 OR s=6 AND st=0 OR s=0 AND st=1
  674. 30425 IF t THEN D$="Wait for " ELSE D$="Send "
  675. 30427 AWRITE 6,18,RPT$ (SP$,26)
  676. 30430 AWRITE 6,18,D$&A$(s) @ AWRITE 6,56,VAL$ (r)
  677. 30440 AWRITE 8,21,VAL$ (pc) @ AWRITE 8,56,VAL$ (nk)
  678. 30450 AWRITE 9,21,FNkb$(k) @ AWRITE 9,56,VAL$ (tmo)
  679. 30460 AWRITE 10,56,VAL$ (bp)
  680. 30470 RETURN
  681. 30500 DEF FNkb$(k) = VAL$ (IP (k/102.4)/10)&"k  "
  682. 40000
  683. 40010
  684. 40020
  685. 40030
  686. 40040
  687. 40050
  688. 40060
  689. 40070
  690. 40080 open_read: ON ERROR GOTO fserr  @ ASSIGN# 1 TO  SF$
  691. 40090 OFF ERROR @ f=0 @ RETURN
  692. 40180
  693. 40190
  694. 40200
  695. 40210 get_data: b=0 @ ON ERROR GOTO 40380
  696. 40220 l=LEN (DB$) @ IF l>= MINL THEN 40330
  697. 40230 t=TYP (1) @ IF t#3 THEN 40250
  698. 40240 e=1 @ OFF ERROR
  699. 40245 IF l=0 THEN OD$="" @ RETURN ELSE 40335
  700. 40250 IF t=1 THEN 40320
  701. 40260 READ# 1 ; S$@ S$=S$&RE$ @ L=LEN (S$) @ k=k+L
  702. 40270 FOR i=1 TO L @ k$=S$[i,i]
  703. 40280 IF k$ <= DEL$ THEN 40300 ELSE k$=FNstbit$(k$)
  704. 40290 IF b=0 THEN DISP "Eight bit data" @ BEEP @ b=1
  705. 40300 IF k$<SP$ THEN DB$=DB$&SQCTL$ @ k$=FNctl$(k$)
  706. 40305 IF k$=SQCTL$ THEN DB$=DB$&k$
  707. 40310 DB$=DB$&k$ @ NEXT i @ GOTO 40220
  708. 40320 IF SC=0 THEN f=23 @ RETURN
  709. 40323 READ# 1,S @ S$=VAL$ (S)
  710. 40325 DB$=DB$&SP$&S$ @ k=k+LEN (S$)+1 @ GOTO 40220
  711. 40330 OFF ERROR
  712. 40335 IF l<= MAXL THEN OD$=DB$ @ DB$="" @ RETURN
  713. 40340 S=MAXL
  714. 40350 IF DB$[S,S]=SQCTL$ THEN S=S-1 @ GOTO 40350
  715. 40360 OD$=DB$[1,S] @ DB$=DB$[S+1,l]
  716. 40370 RETURN
  717. 40380 OFF ERROR @ IF ERRN =71 OR ERRN =72 THEN 40240
  718. 40390 IF ERRN =33 THEN f=23 @ RETURN
  719. 40400 GOTO fserr
  720. 40500
  721. 40510
  722. 40520
  723. 40530 open_write: f=0
  724. 40540 IF DF$#PF$ THEN nf=0 @ GOTO 40560
  725. 40550 IF nf>99 THEN f=6 @ RETURN
  726. 40555 DF$=FNnofile$(DF$)
  727. 40560 ON ERROR GOTO fserr
  728. 40570 CREATE DF$,NR,RL
  729. 40580 ASSIGN# 1 TO  DF$
  730. 40585 OFF ERROR @ PF$=DF$
  731. 40590 RETURN
  732. 40600
  733. 40610
  734. 40620
  735. 40630 put_data: DB$=DB$&ID$ @ k=k+LEN (ID$)
  736. 40635 ON ERROR GOTO fserr
  737. 40640 p=POS (DB$,RE$)
  738. 40645 IF p=0 THEN OFF ERROR @ RETURN
  739. 40650 IF p>1 THEN S$=DB$[1,p-1] ELSE S$=""
  740. 40660 PRINT# 1 ; S$ @ l=LEN (DB$)
  741. 40670 IF l>p+(RE-1) THEN DB$=DB$[p+RE] ELSE DB$=""
  742. 40680 GOTO 40640
  743. 40700
  744. 40710
  745. 40720
  746. 40730 close_write: ON ERROR GOTO fserr
  747. 40740 IF LEN (DB$)>0 THEN PRINT# 1 ; DB$ @ DB$=""
  748. 40750 ASSIGN# 1 TO  *
  749. 40760 OFF ERROR
  750. 40770 RETURN
  751. 41000
  752. 41010
  753. 41020
  754. 41030 fserr: e=ERRN  @ l=ERRL  @ OFF ERROR
  755. 41040 IF e=63 AND l=40570 THEN 40550
  756. 41050 p=POS (FSE$,CHR$ (e))
  757. 41060 IF p>0 THEN f=6+p @ RETURN
  758. 41070 RELEASE KEYBOARD @ DISP "UNEXPECTED ERROR !"
  759. 41080 DISP USING "6A,K,9A,K" ; "ERROR ",e," AT LINE ",l @ END
  760. 42000
  761. 42010
  762. 42020
  763. 42030 DEF FNnofile$(F$)
  764. 42040 IF nf>0 THEN 42120
  765. 42080 IF ft<2 THEN 42110
  766. 42090 np,p=ft @ IF np>5 THEN np=5
  767. 42100 F$[np]="00"&F$[p] @ GOTO 42130
  768. 42110 np=LEN (F$)+1 @ IF np>9 THEN np=9
  769. 42120 F$[np,np+1]=VAL$ (nf DIV 10)&VAL$ (nf MOD 10)
  770. 42130 nf=nf+1 @ FNnofile$=F$
  771. 42140 FN END
  772. 50000
  773. 50001
  774. 50002
  775. 50003
  776. 50004
  777. 50005
  778. 50010
  779. 50015
  780. 50020 rs_set: ABORTIO 10
  781. 50025 IF BR=0 THEN S=2 ELSE S=6
  782. 50030 CONTROL 10,3 ; S
  783. 50035 IF PT=0 THEN S=3 ELSE S=2+((PT-1)*2+1)*8
  784. 50040 CONTROL 10,4 ; S
  785. 50045 IF FC=2 THEN S=48 ELSE S=0
  786. 50050 CONTROL 10,5 ; S
  787. 50055 IF FC=1 OR HS#0 THEN S=128+64*(FC=1) ELSE S=0
  788. 50060 CONTROL 10,11 ; S
  789. 50065 IF FC=2 THEN S=128 ELSE S=0
  790. 50070 CONTROL 10,16 ; S
  791. 50075 IF HS#0 THEN S=4+HS*3+(HS=4) @ HC$=CHR$ (S) ELSE S=17
  792. 50080 CONTROL 10,15 ; S
  793. 50085
  794. 50090 CONTROL 10,9 ; 225
  795. 50100 CONTROL 10,14 ; 19
  796. 50110
  797. 50120 IOBUFFER IBUFF$
  798. 50130 IOBUFFER OBUFF$
  799. 50140 TRANSFER 10 TO  IBUFF$ INTR
  800. 50145 RETURN
  801. 50150
  802. 50160
  803. 50170
  804. 50180 dummy: RETURN
  805. 50190
  806. 50200
  807. 50210
  808. 50220 dkeys: FOR i=1 TO 14 @ ON KEY# i GOSUB dummy  @ NEXT i @ RETURN
  809. 50500
  810. 50510
  811. 50520
  812. 50530 DEF FNfsplit(F$[80])
  813. 50540 p=0 @ l=LEN (F$)
  814. 50545 IF l<3 THEN 50570
  815. 50550 IF F$[1,1]#Q$ THEN 50570
  816. 50560 p=POS (F$[2],Q$) @ IF p<2 THEN p=0
  817. 50570 FNfsplit=p
  818. 50580 FN END
  819. 51000
  820. 51001
  821. 51002
  822. 51010 DEF FNinlist(c$,l$[195])
  823. 51020 c$=UPC$ (c$) @ l,j=1 @ L=LEN (l$)
  824. 51030 IF c$#"?" THEN 51100
  825. 51040 j=-1 @ IF L<68 THEN P=L @ GOTO 51070
  826. 51045 AWRITE 22,0,RPT$ (SP$,160)
  827. 51050 p=POS (l$[l],", ")
  828. 51055 IF p=0 THEN P=L @ GOTO 51070
  829. 51060 l=l+p @ IF l<68 THEN P=l-1 @ GOTO 51045
  830. 51070 AWRITE 22,0,"Options :- "&l$[1,P] @ IF P=L THEN 51150
  831. 51080 l$=l$[P+2] @ L=L-P-1 @ l=1
  832. 51085 AWRITE 23,0,"Press any key for more"
  833. 51090 k$=KEY$  @ IF k$="" THEN 51090 ELSE 51045
  834. 51100 cp=POS (l$[l],",")
  835. 51110 IF cp>0 THEN cp=cp+l-1 ELSE cp=L
  836. 51120 p=POS (l$[l,cp],c$) @ IF p=1 THEN 51150
  837. 51130 j=j+1 @ l=cp+2 @ IF l<L THEN 51100
  838. 51140 j=0
  839. 51150 FNinlist=j
  840. 51160 FN END
  841. 51200
  842. 51210
  843. 51220
  844. 51230 DEF FNpval(c$,o)
  845. 51240 IF c$#"?" THEN 51270
  846. 51250 DF$="value" @ p=0
  847. 51260 GOTO 51300
  848. 51270 c=NUM (c$)
  849. 51280 IF c<48 OR c>58 THEN I$=IV$ @ p=0 @ GOTO 51300
  850. 51290 o=VAL (c$)
  851. 51300 FNpval=o
  852. 51310 FN END
  853. 51400
  854. 51410
  855. 51420
  856. 51430 DEF FNlset(c$,o,l$[183])
  857. 51440 p=FNinlist(c$,l$) @ IF p<1 THEN I$=IO$ ELSE o=p-1
  858. 51450 FNlset=o @ FN END
  859. 52000
  860. 52010
  861. 52020
  862. 52030 DEF FNxlist$(l$[183],p)
  863. 52040 j=1 @ l=1 @ L=LEN (l$)
  864. 52050 cp=POS (l$[l],", ")
  865. 52060 IF cp>0 THEN cp=cp+l-2 ELSE cp=L
  866. 52070 IF j=p THEN FNxlist$=l$[l,cp] @ GOTO 52100
  867. 52080 j=j+1 @ l=cp+3 @ IF l<L THEN 52050
  868. 52090 FNxlist$=""
  869. 52100 FN END
  870.